home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / program / misc / m2pica.lha / M2Pica / Txt / VilIntuiSupD.mod < prev    next >
Text File  |  1995-08-21  |  18KB  |  669 lines
  1. (*******************************************************************************
  2.  : Program.         VilIntuiSupD.mod
  3.  : Author.          Carsten Wartmann (Crazy Video)
  4.  : Address.         Wutzkyallee 83, 12353 Berlin
  5.  : Phone.           030/6614776
  6.  : E-Mail           C.Wartmann@GANDALF.berlinet.de (bevorzugt)
  7.  : E-Mail           Carsten_Wartmann@tfh-berlin.de
  8.  : Version.         1.0
  9.  : Date.            21.08.1995 (16.Nov.1994)
  10.  : Copyright.       Freeware
  11.  : Language.        Modula-2
  12.  : Compiler.        M2Amiga V4.3d
  13.  : Contents.        Macht die VilIntuiSup.library für MODULA-2 (M2Amiga)
  14.  : Contents.        Programmierer nutzbar.
  15.  : Contents.        Enthält die Punktsetzroutinen in Assembler und zwei
  16.  : Contents.        Linienroutinen.
  17. *******************************************************************************)
  18.  
  19. IMPLEMENTATION MODULE VilIntuiSupD ;
  20. (*
  21. (*$ StackChk:=FALSE *)
  22. (*$ RangeChk:=FALSE *)
  23. (*$ OverflowChk:=FALSE *)
  24. (*$ NilChk:=FALSE *)
  25. (*$ EntryClear:=FALSE *)
  26. (*$ CaseChk:=FALSE *)
  27. (*$ ReturnChk:=FALSE *)
  28. (*$ StackParms:=FALSE *)
  29. *)
  30.  
  31. (* ToDo : Routinen um Blitten zu vereinfachen, ClearScreen *)
  32.  
  33.  
  34. FROM SYSTEM     IMPORT ASSEMBLE,ADDRESS,ADR,SHIFT ;
  35. FROM Arts       IMPORT Assert ;
  36. FROM ExecL      IMPORT Permit,Forbid ;
  37. FROM IntuitionL IMPORT ScreenToFront ;
  38. FROM IntuitionD IMPORT ScreenPtr,Screen ;
  39. FROM UtilityD   IMPORT TagItemPtr ;
  40.  
  41. FROM MathLib0   IMPORT sin,cos,pi ;
  42.  
  43. IMPORT DosL ;
  44. IMPORT Vil:VilIntuiSupL ;
  45.  
  46. IMPORT R ;
  47.  
  48.  
  49. CONST Step = pi / 32.0 ;
  50.  
  51.  
  52. PROCEDURE ClearScreen(scr : ScreenPtr) ;
  53. VAR  fill  : VilFillRecord ;
  54.      start : ADDRESS ;
  55.      ok    : LONGINT ;
  56.  
  57. BEGIN
  58.   Forbid() ;
  59.    ScreenToFront(scr) ;
  60.    start := Vil.LockVillageScreen(scr) ;
  61.   Permit() ;
  62.  
  63.   fill.dstAdr   := start ;
  64.   fill.dstPitch := scr^.width ;
  65.   fill.width    := scr^.width ;
  66.   fill.height   := scr^.height ;
  67.   fill.color    := VilZero ;
  68.  
  69.   ok := Vil.VillageRectFill(scr,ADR(fill)) ;
  70.   Vil.UnLockVillageScreen(scr) ;
  71.  
  72. END ClearScreen ;
  73.  
  74.  
  75. PROCEDURE ClearBuf(scr : ScreenPtr ; bufadr : ADDRESS) ;
  76. VAR  fill  : VilFillRecord ;
  77.      start : ADDRESS ;
  78.      ok    : LONGINT ;
  79.  
  80. BEGIN
  81.  
  82.   fill.dstAdr   := bufadr ;
  83.   fill.dstPitch := scr^.width ;
  84.   fill.width    := scr^.width ;
  85.   fill.height   := SHIFT(scr^.height,-1) ;
  86.   fill.color    := VilZero ;
  87.  
  88.   ok := Vil.VillageRectFill(scr,ADR(fill)) ;
  89. (*  Vil.WaitVillageBlit ;*)
  90.  
  91. END ClearBuf ;
  92.  
  93.  
  94. (* für 68020er aufwärts *)
  95. PROCEDURE SetPackedPixelO(scr{R.A0} : ScreenPtr ; x{R.D2},y{R.D3},color{R.D4} : CARDINAL) ;
  96.  
  97.   BEGIN
  98.     ASSEMBLE( MULU     Screen.width(A0),D3
  99.               ADD.L    D2,D3
  100.               MOVE.B   D4,([Screen.bitMap.planes,A0],D3.L)
  101.               END) ;
  102.   END SetPackedPixelO ;
  103.  
  104.  
  105. (* für 68000 ca. 2,5 Mal schneller als ein Modula-2 Konstrukt*)
  106. PROCEDURE SetPackedPixel(scr{R.A0} : ScreenPtr ; x{R.D2},y{R.D3},color{R.D4} : CARDINAL) ;
  107.  
  108.   BEGIN
  109.     (* Für 68000 *)
  110.     ASSEMBLE( MOVE.L   Screen.bitMap.planes(A0),A1
  111.               MULU     Screen.width(A0),D3
  112.               ADD.L    D2,D3
  113.               MOVE.B   D4,(A1,D3.L)
  114.               END) ;
  115.   END SetPackedPixel ;
  116.  
  117.  
  118.  
  119.  
  120. PROCEDURE SetPPM(scr : ScreenPtr ; x,y : CARDINAL ; color : SHORTCARD) ;
  121. VAR strt   : ADDRESS ;
  122.     offset : LONGCARD ;
  123.  
  124.   BEGIN
  125.     strt  := scr^.bitMap.planes[0] ;
  126.     offset := LONGCARD(scr^.width) * LONGCARD(y) + x ;
  127.     INC(strt,offset) ;
  128.     strt^ := color ;
  129.  
  130.   END SetPPM ;
  131.  
  132.  
  133.  
  134.  
  135. PROCEDURE SetTrueColorPixel(scr{R.A0} : ScreenPtr ; x{R.D2},y{R.D3}         : CARDINAL ;
  136.                                                     r{R.D4},g{R.D5},b{R.D6} : CARDINAL) ;
  137.   BEGIN
  138.     (* Set TC Pix *)
  139.     ASSEMBLE( MOVE.L   Screen.bitMap.planes(A0),A1
  140.               MULU     Screen.width(A0),D3
  141.               ADD.L    D2,D3
  142.               MOVE.L   D3,D2
  143.               ADD.L    D2,D3
  144.               ADD.L    D2,D3
  145.               MOVE.B   D6,(A1,D3.L)       (* evtl. vorher A1+D3 rechnen ?*)
  146.               MOVE.B   D5,1(A1,D3.L)
  147.               MOVE.B   D4,2(A1,D3.L)
  148.               END) ;
  149.   END SetTrueColorPixel ;
  150.  
  151.  
  152. PROCEDURE Set15BitPixel(scr{R.A0} : ScreenPtr ; x{R.D2},y{R.D3}         : CARDINAL ;
  153.                                                 r{R.D4},g{R.D5},b{R.D6} : CARDINAL) ;
  154.   BEGIN
  155.     (* Set 15Bit Pix *)
  156.     ASSEMBLE( MOVE.L   Screen.bitMap.planes(A0),A1 (* ADR. der Planes holen*)
  157.               MULU     Screen.width(A0),D3         (* Y*Scr.Width*)
  158.               ADD.L    D2,D3   (* + x *)
  159.               MOVE.L   D3,D2   (*evtl. SHIFTEN? Testen wir halt mal..*)
  160.               ADD.L    D2,D3   (* Mal 2 wg. 1 Pixel = 2 BYTE *)
  161.               ADD.L    D3,A1   (* Base + Offset *)
  162.  
  163.               MOVE.B   D5,D2   (* Ist wohl etwas langsam aber wer *)
  164.               LSL.B    #5,D2   (* benutzt schon Hi-Color ?        *)
  165.               MOVE.B   D6,D3
  166.               ANDI.B   #$1F,D3
  167.               OR.B     D3,D2
  168.               MOVE.B   D2,(A1)+
  169.               MOVE.B   D5,D2
  170.               LSR.B    #3,D2
  171.               MOVE.B   D4,D3
  172.               LSL.B    #2,D3
  173.               ANDI.B   #$7C,D3
  174.               OR.B     D3,D2
  175.               MOVE.B   D2,(A1)
  176.               END) ;
  177.   END Set15BitPixel ;
  178.  
  179. PROCEDURE Set16BitPixel(scr{R.A0} : ScreenPtr ; x{R.D2},y{R.D3}         : CARDINAL ;
  180.                                                 r{R.D4},g{R.D5},b{R.D6} : CARDINAL) ;
  181.   BEGIN
  182.     (* Set 16Bit Pix *)
  183.     ASSEMBLE( MOVE.L   Screen.bitMap.planes(A0),A1 (* ADR. der Planes holen*)
  184.               MULU     Screen.width(A0),D3         (* Y*Scr.Width*)
  185.               ADD.L    D2,D3   (* + x *)
  186.               MOVE.L   D3,D2   (*evtl. SHIFTEN? Testen wir halt mal..*)
  187.               ADD.L    D2,D3   (* Mal 2 wg. 1 Pixel = 2 BYTE *)
  188.               ADD.L    D3,A1   (* Base + Offset *)
  189.  
  190.               MOVE.B   D5,D2   (* Ist wohl etwas langsam aber wer *)
  191.               LSL.B    #5,D2   (* benutzt schon Hi-Color ?        *)
  192.               MOVE.B   D6,D3
  193.               ANDI.B   #$1F,D3
  194.               OR.B     D3,D2
  195.               MOVE.B   D2,(A1)+
  196.               MOVE.B   D5,D2
  197.               LSR.B    #3,D2
  198.               MOVE.B   D4,D3
  199.               LSL.B    #3,D3
  200.               ANDI.B   #$F8,D3
  201.               OR.B     D3,D2
  202.               MOVE.B   D2,(A1)
  203.               END) ;
  204.   END Set16BitPixel ;
  205.  
  206.  
  207.  
  208. PROCEDURE Get15FromRGB(r{R.D4},g{R.D5},b{R.D6} : CARDINAL) : CARDINAL ;
  209.   BEGIN
  210.     ASSEMBLE( MOVE.W   D5,D0    (* Ist wohl etwas langsam aber wer *)
  211.               LSL.W    #8,D0    (* benutzt schon Hi-Color ?        *)
  212.               LSL.W    #5,D0    (* benutzt schon Hi-Color ?        *)
  213.               MOVE.W   D6,D3
  214.               ANDI.W   #$1F,D3
  215.               LSL.W    #8,D3
  216.               OR.W     D3,D0
  217.  
  218.               MOVE.B   D4,D2
  219.               LSL.B    #2,D2
  220.               ANDI.B   #$7C,D2
  221.               MOVE.B   D5,D3
  222.               LSR.B    #3,D3
  223.               ANDI.B   #$03,D3
  224.               OR.W     D3,D2
  225.               OR.W     D2,D0
  226.               END) ;
  227.   END Get15FromRGB ;
  228.  
  229.  
  230. PROCEDURE Get16FromRGB(r{R.D4},g{R.D5},b{R.D6} : CARDINAL) : CARDINAL ;
  231.   BEGIN
  232.     ASSEMBLE( MOVE.W   D5,D0    (* Ist wohl etwas langsam aber wer *)
  233.               LSL.W    #8,D0    (* benutzt schon Hi-Color ?        *)
  234.               LSL.W    #5,D0    (* benutzt schon Hi-Color ?        *)
  235.               MOVE.W   D6,D3
  236.               ANDI.W   #$1F,D3
  237.               LSL.W    #8,D3
  238.               OR.W     D3,D0
  239.  
  240.               MOVE.B   D4,D2
  241.               LSL.B    #2,D2
  242.               ANDI.B   #$7C,D2
  243.               MOVE.B   D5,D3
  244.               LSR.B    #3,D3
  245.               ANDI.B   #$03,D3
  246.               OR.W     D3,D2
  247.               OR.W     D2,D0
  248.               END) ;
  249.   END Get16FromRGB ;
  250.  
  251.  
  252. PROCEDURE LinePackedM(scr{R.A0} : ScreenPtr ; x1{R.D2},y1{R.D3},x2,y2,color{R.D4} : INTEGER) ;
  253. VAR i,
  254.     s1,s2        : INTEGER ;
  255.     dx,dy        : INTEGER ;
  256.     e            : LONGINT ;
  257.     change       : BOOLEAN ;
  258.     lock{R.A1}   : ADDRESS ;
  259.  
  260.  
  261.   BEGIN
  262.     IF (x1>scr^.width) OR (x2>scr^.width)
  263.         OR (y1>scr^.height) OR (y2>scr^.height) THEN
  264.       RETURN
  265.     END ;
  266.  
  267.     dx := ABS(x2 - x1) ;
  268.     dy := ABS(y2 - y1) ;
  269.     IF dx#0 THEN
  270.       s1 := (x2 - x1) DIV dx ;
  271.     END ;
  272.     IF dy#0 THEN
  273.       s2 := (y2 - y1) DIV dy ;
  274.     END ;
  275.  
  276.     IF dy>dx THEN
  277.       dy := dx ;
  278.       dx := ABS(y2 - y1) ;
  279.       change := TRUE ;
  280.     ELSE
  281.       change := FALSE ;
  282.     END ;
  283.  
  284.     e  := 2*dy - dx ;
  285.  
  286.     lock := Vil.LockVillageScreen(scr) ;
  287.  
  288.     FOR i:=1 TO dx DO
  289.     ASSEMBLE( MOVEM.L  D2-D3,-(A7)
  290.               MULU     Screen.width(A0),D3
  291.               ADD.L    D2,D3
  292.               MOVE.B   D4,(A1,D3.L)
  293.               MOVEM.L  (A7)+,D2-D3
  294.               END) ;
  295.       WHILE e>=0 DO
  296.         IF change THEN
  297.           INC(x1,s1) ;
  298.         ELSE
  299.           INC(y1,s2)
  300.         END ;
  301.         e:=e-2*dx ;
  302.       END (*WHILE*) ;
  303.       IF change THEN
  304.         INC(y1,s2)
  305.       ELSE
  306.         INC(x1,s1) ;
  307.       END ;
  308.       e:=e+2*dy ;
  309.     END (*FOR i*) ;
  310.  
  311.   Vil.UnLockVillageScreen(scr) ;
  312.  
  313.   END LinePackedM ;
  314.  
  315.  
  316. (*$EntryExitCode := FALSE *)
  317. PROCEDURE TstL(scr{R.A0} : ScreenPtr ; a{R.D3} : LONGINT) ;
  318.   BEGIN
  319.   ASSEMBLE(        MOVEM.L     D2-D7/A2-A6,-(A7)
  320.             MOVE.L         Vil(A4),A6
  321.             JSR        Vil.LockVillageScreen(A6)
  322.             MOVE.L        D0,A1
  323.             MOVE.L        D3,D1
  324.   Loop:            MOVE.B        #1,(A1)+
  325.             DBRA        D1,Loop
  326.             MOVEM.L     (A7)+,D2-D7/A2-A6
  327.             RTS
  328.             END) ;
  329.   END TstL ;
  330.  
  331.  
  332. (*$EntryExitCode := FALSE *)
  333. PROCEDURE LinePacked(scr{R.A0} : ScreenPtr ; x1{R.D5},y1{R.D6},
  334.                                              x2{R.D2},y2{R.D3},color{R.D4} : LONGINT) ;
  335.   BEGIN
  336. ASSEMBLE(    MOVEM.L     D2-D7/A6,-(A7)        (* Register retten     *)
  337.         CMPI.W        #0,D5
  338.         BLT.S        Fail
  339.         CMPI.W        #0,D6
  340.         BLT.S        Fail
  341.         CMPI.W        #0,D2
  342.         BLT.S        Fail
  343.         CMPI.W        #0,D3
  344.         BLT.S        Fail
  345.         CMP.W        Screen.width(A0),D5
  346.         BPL.S        Fail
  347.         CMP.W        Screen.width(A0),D2
  348.         BPL.S        Fail
  349.         CMP.W        Screen.height(A0),D6
  350.         BPL.S        Fail
  351.         CMP.W        Screen.height(A0),D3
  352.         BMI.S        Los
  353. Fail:        BRA        Ende
  354.  
  355. Los:        EXG.L        D5,D0
  356.         EXG.L        D6,D1
  357.  
  358.           MOVEQ.L        #1,D5            (* xsign := 1         *)
  359.         MOVEQ.L        #0,D6            (* ysign := 0         *)
  360.         MOVE.W        Screen.width(A0),D6    (* ysign := width      *)
  361.         MOVE.L        D6,D7            (* ysign -> D7          *)
  362.         MULU        D1,D7            (* width * y1          *)
  363.         ADD.L        D0,D7            (* + x1              *)
  364.         CMP.L        D0,D2            (* x1 > x2         *)
  365.         BGT.S        LPJ1            (* ja, dann LPJ1     *)
  366.         NEG.L        D5            (* sonst xsign := -1     *)
  367.         EXG.L        D0,D2            (* SWAP x1,y1         *)
  368. LPJ1:        CMP.L        D1,D3            (* y1 > y2 ?         *)
  369.         BGT.S        LPJ2            (* ja, dann LPJ2     *)
  370.         NEG.L        D6            (* sonst ysign := -ysign *)
  371.         EXG.L        D1,D3            (* SWAP y1,y2         *)
  372. LPJ2:        SUB.L        D0,D2            (* x1 - x2 -> D2     *)
  373.         SUB.L        D1,D3            (* y1 - y2 -> D3     *)
  374.         MOVE.L        A0,A3            (* scrptr nach A3 sichern*)
  375.         MOVE.L         Vil(A4),A6        (* VilBase nach A6      *)
  376.         JSR        Vil.LockVillageScreen(A6)  (* LockScreen     *)
  377.         ADD.L        D7,D0            (* memstrt + D7    -> D0     *)
  378.         MOVE.L        D0,A0            (* D0 -> A0 1. Pixel      *)
  379.         CMP.L        D2,D3            (* xoff(D2) >= yoff(D3)? *)
  380.         BLT.S        LPStart            (* ja, dann LPStart     *)
  381.         EXG.L        D5,D6            (* sonst SWAP xsig<->ysig*)
  382.         EXG.L        D2,D3            (* und   SWAP Xoff<->Yoff*)
  383.  
  384. LPStart:    MOVE.L        D2,D7            (* akku := xoffs     *)
  385.         NEG.L        D7            (* akku := - akku     *)
  386.         MOVE.L        D2,D1            (* offset := xoffs     *)
  387.         ADD.L        D5,D6            (* ysign := ysign + xsign*)
  388.         BRA.S        LPGo            (* wg. Abfrage auf -1     *)
  389. LPLoop:        ADD.L        D3,D7            (* akku := akku + yoffs     *)
  390.         TST.L        D7            (* akku < 0 ?         *)
  391.         BMI.S        LPP            (* ja, dann LPP         *)
  392.         SUB.L        D2,D7            (* akku:=akku - xoffs     *)
  393.         ADDA.L        D6,A0            (* scradr := scradr+ysig *)
  394.         BRA.S        LPGo            (* nach LPGo         *)
  395. LPP:        ADDA.L        D5,A0            (* scradr :=scradr+xsign *)
  396. LPGo:        MOVE.B        D4,(A0)            (* color -> Pixadr     *)
  397.         DBRA        D1,LPLoop        (* Dec(offset) , LPLoop     *)
  398.  
  399.         MOVE.L        A3,A0            (* Screen UnLock     *)
  400.         MOVE.L         Vil(A4),A6
  401.         JSR        Vil.UnLockVillageScreen(A6)
  402. Ende:        MOVEM.L     (A7)+,D2-D7/A6         (* Register zurück     *)
  403.         RTS
  404.         END) ;
  405.  
  406.   END LinePacked ;
  407.  
  408.  
  409. (*$EntryExitCode := FALSE *)
  410. PROCEDURE LinePackedO(scr{R.A0} : ScreenPtr ; x1{R.D5},y1{R.D6},
  411.                                               x2{R.D2},y2{R.D3},color{R.D4} : LONGINT) ;
  412.   BEGIN
  413. ASSEMBLE(
  414.         MOVEM.L     D2-D7/A6,-(A7)        (* Register retten     *)
  415.         EXG.L        D5,D0            (* Ist leider nötig, da  *)
  416.         EXG.L        D6,D1            (* D1,D2 nicht als Par.  *)
  417.           MOVEQ.L        #1,D5            (* xsign := 1         *)
  418.         MOVEQ.L        #0,D6            (* ysign := 0         *)
  419.         MOVE.W        Screen.width(A0),D6    (* ysign := width      *)
  420.         MOVE.L        D6,D7            (* ysign -> D7          *)
  421.         MULU        D1,D7            (* width * y1          *)
  422.         ADD.L        D0,D7            (* + x1              *)
  423.         CMP.L        D0,D2            (* x1 > x2         *)
  424.         BGT.S        LPJ1            (* ja, dann LPJ1     *)
  425.         NEG.L        D5            (* sonst xsign := -1     *)
  426.         EXG.L        D0,D2            (* SWAP x1,y1         *)
  427. LPJ1:        CMP.L        D1,D3            (* y1 > y2 ?         *)
  428.         BGT.S        LPJ2            (* ja, dann LPJ2     *)
  429.         NEG.L        D6            (* sonst ysign := -ysign *)
  430.         EXG.L        D1,D3            (* SWAP y1,y2         *)
  431. LPJ2:        SUB.L        D0,D2            (* x1 - x2 -> D2     *)
  432.         SUB.L        D1,D3            (* y1 - y2 -> D3     *)
  433.         MOVE.L        A0,A1            (* scrptr nach A3 sichern*)
  434.         MOVE.L         Vil(A4),A6        (* VilBase nach A6      *)
  435.         JSR        Vil.LockVillageScreen(A6)  (* LockScreen     *)
  436.         ADD.L        D7,D0            (* memstrt + D7    -> D0     *)
  437.         MOVE.L        D0,A0            (* D0 -> A0 1. Pixel      *)
  438.         CMP.L        D2,D3            (* xoff(D2) >= yoff(D3)? *)
  439.         BLT.S        LPStart            (* ja, dann LPStart     *)
  440.         EXG.L        D5,D6            (* sonst SWAP xsig<->ysig*)
  441.         EXG.L        D2,D3            (* und   SWAP Xoff<->Yoff*)
  442.  
  443. LPStart:    MOVE.L        D2,D7            (* akku := xoffs     *)
  444.         NEG.L        D7            (* akku := - akku     *)
  445.         MOVE.L        D2,D1            (* offset := xoffs     *)
  446.         ADD.L        D5,D6            (* ysign := ysign + xsign*)
  447.         BRA.S        LPGo            (* Wegen Abfrage auf -1  *)
  448. LPLoop:        ADD.L        D3,D7            (* akku := akku + yoffs     *)
  449.         TST.L        D7            (* akku < 0 ?         *)
  450.         BMI.S        LPP            (* ja, dann LPP         *)
  451.         SUB.L        D2,D7            (* akku:=akku - xoffs     *)
  452.         ADDA.L        D6,A0            (* scradr := scradr+ysig *)
  453.         BRA.S        LPGo            (* nach LPGo         *)
  454. LPP:        ADDA.L        D5,A0            (* scradr :=scradr+xsign *)
  455. LPGo:        MOVE.B        D4,(A0)            (* color -> Pixadr     *)
  456. Loop:        DBRA        D1,LPLoop        (* Dec(offset) , LPLoop     *)
  457.  
  458.         MOVE.L        A1,A0            (* Screen UnLock     *)
  459.         MOVE.L         Vil(A4),A6
  460.         JSR        Vil.UnLockVillageScreen(A6)
  461.         MOVEM.L     (A7)+,D2-D7/A6         (* Register zurück     *)
  462.         RTS
  463.         END) ;
  464.  
  465.   END LinePackedO ;
  466.  
  467.  
  468.  
  469.  
  470. PROCEDURE LineTrueColor(scr : ScreenPtr ; x1,y1,x2,y2,r,g,b : INTEGER) ;
  471. VAR i,
  472.     s1,
  473.     s2           : INTEGER ;
  474.     dx,dy        : INTEGER ;
  475.     e            : LONGINT ;
  476.     change       : BOOLEAN ;
  477.     lock         : ADDRESS ;
  478.  
  479.  
  480.   BEGIN
  481.     IF (x1>scr^.width) OR (x2>scr^.width)
  482.         OR (y1>scr^.height) OR (y2>scr^.height) THEN
  483.       RETURN
  484.     END ;
  485.  
  486.     dx := ABS(x2 - x1) ;
  487.     dy := ABS(y2 - y1) ;
  488.     IF dx#0 THEN
  489.       s1 := (x2 - x1) DIV dx ;
  490.     END ;
  491.     IF dy#0 THEN
  492.       s2 := (y2 - y1) DIV dy ;
  493.     END ;
  494.  
  495.     IF dy>dx THEN
  496.       dy := dx ;
  497.       dx := ABS(y2 - y1) ;
  498.       change := TRUE ;
  499.     ELSE
  500.       change := FALSE ;
  501.     END ;
  502.  
  503.     e  := 2*dy - dx ;
  504.  
  505.     lock := Vil.LockVillageScreen(scr) ;
  506.  
  507.     FOR i:=1 TO dx DO
  508.       SetTrueColorPixel(scr,x1,y1,r,g,b) ;
  509.       WHILE e>=0 DO
  510.         IF change THEN
  511.           x1 := x1 + s1 ;
  512.         ELSE
  513.           y1 := y1 + s2 ;
  514.         END ;
  515.         e:=e-2*dx ;
  516.       END (*WHILE*) ;
  517.       IF change THEN
  518.         y1 := y1 + s2 ;
  519.       ELSE
  520.         x1 := x1 + s1 ;
  521.       END ;
  522.       e:=e+2*dy ;
  523.     END (*FOR i*) ;
  524.  
  525.   Vil.UnLockVillageScreen(scr) ;
  526.  
  527.   END LineTrueColor ;
  528.  
  529.  
  530. PROCEDURE Line15Bit(scr : ScreenPtr ; x1,y1,x2,y2,r,g,b : INTEGER) ;
  531. VAR i,
  532.     s1,s2        : INTEGER ;
  533.     dx,dy        : INTEGER ;
  534.     e            : LONGINT ;
  535.     change       : BOOLEAN ;
  536.     lock         : ADDRESS ;
  537.  
  538.  
  539.   BEGIN
  540.     IF (x1>scr^.width) OR (x2>scr^.width)
  541.         OR (y1>scr^.height) OR (y2>scr^.height) THEN
  542.       RETURN
  543.     END ;
  544.  
  545.     dx := ABS(x2 - x1) ;
  546.     dy := ABS(y2 - y1) ;
  547.     IF dx#0 THEN
  548.       s1 := (x2 - x1) DIV dx ;
  549.     END ;
  550.     IF dy#0 THEN
  551.       s2 := (y2 - y1) DIV dy ;
  552.     END ;
  553.  
  554.     IF dy>dx THEN
  555.       dy := dx ;
  556.       dx := ABS(y2 - y1) ;
  557.       change := TRUE ;
  558.     ELSE
  559.       change := FALSE ;
  560.     END ;
  561.  
  562.     e  := 2*dy - dx ;
  563.  
  564.     lock := Vil.LockVillageScreen(scr) ;
  565.  
  566.     FOR i:=1 TO dx DO
  567.       Set15BitPixel(scr,x1,y1,r,g,b) ;
  568.       WHILE e>=0 DO
  569.         IF change THEN
  570.           x1 := x1 + s1 ;
  571.         ELSE
  572.           y1 := y1 + s2 ;
  573.         END ;
  574.         e:=e-2*dx ;
  575.       END (*WHILE*) ;
  576.       IF change THEN
  577.         y1 := y1 + s2 ;
  578.       ELSE
  579.         x1 := x1 + s1 ;
  580.       END ;
  581.       e:=e+2*dy ;
  582.     END (*FOR i*) ;
  583.  
  584.   Vil.UnLockVillageScreen(scr) ;
  585.  
  586.   END Line15Bit ;
  587.  
  588.  
  589. PROCEDURE Line16Bit(scr : ScreenPtr ; x1,y1,x2,y2,r,g,b : INTEGER) ;
  590. VAR i,
  591.     s1,s2        : INTEGER ;
  592.     dx,dy        : INTEGER ;
  593.     e            : LONGINT ;
  594.     change       : BOOLEAN ;
  595.     lock         : ADDRESS ;
  596.  
  597.  
  598.   BEGIN
  599.     IF (x1>scr^.width) OR (x2>scr^.width)
  600.         OR (y1>scr^.height) OR (y2>scr^.height) THEN
  601.       RETURN
  602.     END ;
  603.  
  604.     dx := ABS(x2 - x1) ;
  605.     dy := ABS(y2 - y1) ;
  606.     IF dx#0 THEN
  607.       s1 := (x2 - x1) DIV dx ;
  608.     END ;
  609.     IF dy#0 THEN
  610.       s2 := (y2 - y1) DIV dy ;
  611.     END ;
  612.  
  613.     IF dy>dx THEN
  614.       dy := dx ;
  615.       dx := ABS(y2 - y1) ;
  616.       change := TRUE ;
  617.     ELSE
  618.       change := FALSE ;
  619.     END ;
  620.  
  621.     e  := 2*dy - dx ;
  622.  
  623.     lock := Vil.LockVillageScreen(scr) ;
  624.  
  625.     FOR i:=1 TO dx DO
  626.       Set16BitPixel(scr,x1,y1,r,g,b) ;
  627.       WHILE e>=0 DO
  628.         IF change THEN
  629.           x1 := x1 + s1 ;
  630.         ELSE
  631.           y1 := y1 + s2 ;
  632.         END ;
  633.         e:=e-2*dx ;
  634.       END (*WHILE*) ;
  635.       IF change THEN
  636.         y1 := y1 + s2 ;
  637.       ELSE
  638.         x1 := x1 + s1 ;
  639.       END ;
  640.       e:=e+2*dy ;
  641.     END (*FOR i*) ;
  642.  
  643.   Vil.UnLockVillageScreen(scr) ;
  644.  
  645.   END Line16Bit ;
  646.  
  647.  
  648. PROCEDURE Kreis(scr : ScreenPtr ; x,y,r,col : INTEGER) ;
  649. VAR xx,yy,w : INTEGER ;
  650.     wi      : REAL ;
  651.   BEGIN
  652.     FOR w := 0 TO 360 DO
  653.       wi := wi + Step ;
  654.       xx := INTEGER(sin(wi) * REAL(r)) ;
  655.       yy := INTEGER(cos(wi) * REAL(r)) ;
  656.       SetPackedPixel(scr,x+xx,y+yy,col)
  657.     END
  658.   END Kreis ;
  659.  
  660.  
  661. BEGIN
  662.  
  663. CLOSE
  664. (*
  665.   Assert(FALSE,ADR("Modula-2 Schnittstelle zur PICASSO\nDemo V0.99 ©1994 By Carsten Wartmann")) ;
  666. *)
  667. END VilIntuiSupD.
  668.  
  669.